home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 16 / 016.d81 / cribbage sol (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  13KB  |  460 lines
  1. 10 rem **********************
  2. 12 rem *                    *
  3. 14 rem * cribbage solitaire *
  4. 15 rem *   (commodore 64)   *
  5. 16 rem *        by          *
  6. 17 rem * chris constantinou *
  7. 18 rem *   february 1984    *
  8. 19 rem *                    *
  9. 20 rem **********************
  10. 70 lh=999:lc=999
  11. 80 poke53280,11:poke53281,15
  12. 90 def fnb(x)=int(x*10+.5)/10
  13. 95 poke54296,15:poke54277,68:poke54273,63:poke54272,75
  14. 110 dima(54),de(54),a$(11),rr$(13),v(13),r(13)
  15. 120 fori=1to13:readrr$(i):nexti
  16. 130 fori=1to13:readv(i):nexti
  17. 135 fori=1to13:readr(i):nexti
  18. 140 data a,2,3,4,5,6,7,8,9,10,j,q,k
  19. 150 data 1,2,3,4,5,6,7,8,9,10,10,10,10
  20. 155 data 1,2,3,4,5,6,7,8,9,10,11,12,13
  21. 160 print"[147]                                       [146]"
  22. 161 print"           cribbage solitaire          [146]"
  23. 162 print"                                       [146]"
  24. 164 print"           do you wish to see"
  25. 165 printtab(16)"playing"
  26. 167 printtab(10)"[207][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][208]"
  27. 168 printtab(10)"[165]if yes,enter y or [167]"
  28. 170 printtab(10)"[165]hit return[146] to play[167]"
  29. 171 printtab(10)"[204][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][186]"
  30. 173 input"[145][145][145][145][145][145][145]            instructions  n[157][157][157]";a$
  31. 175 ifleft$(a$,1)="y"thengosub2600
  32. 178 print"[147]                                       [146]"
  33. 179 print"           cribbage solitaire          [146]"
  34. 180 print"                                       [146]"
  35. 181 print"      shuffling the deck of cards"
  36. 182 printtab(13)"is in process"
  37. 185 fori=1to52:a(i)=i:nexti:i=1:cc=0:s=1:gt=0:hl=0:cl=0
  38. 190 forw=1to6:rem deal random cards to crib
  39. 200 cd=0:fori=itoi+1
  40. 220 gosub1005:rem deal random cards to crib
  41. 230 ifde(i)>39then270
  42. 240 ifde(i)>26then280
  43. 250 ifde(i)>13then290
  44. 260 r=de(i):sc$(cd)="[211]":goto295
  45. 270 r=de(i)-39:sc$(cd)="[193]":goto295
  46. 280 r=de(i)-26:sc$(cd)="[216]":goto295
  47. 290 r=de(i)-13:sc$(cd)="[218]"
  48. 295 rc$(cd)=rr$(r):rc(cd)=r(r):vc(cd)=v(r):nexti
  49. 395 rem *** deal hand ***
  50. 400 cd=0:fori=itoi+5
  51. 410 gosub1005:rem ** deal random cards **
  52. 420 ifde(i)>39then460
  53. 430 ifde(i)>26then470
  54. 440 ifde(i)>13then480
  55. 450 r=de(i):s$(cd)="[211]":goto485
  56. 460 r=de(i)-39:s$(cd)="[193]":goto485
  57. 470 r=de(i)-26:s$(cd)="[216]":goto485
  58. 480 r=de(i)-13:s$(cd)="[218]"
  59. 485 r$(cd)=rr$(r):rh(cd)=r(r):vh(cd)=v(r)
  60. 490 ifi=53then494
  61. 492 goto500
  62. 494 r$(6)=tr$(1):s$(6)=ts$(1):rh(6)=tr(1):vh(6)=tv(1):i=54
  63. 500 nexti
  64. 600 print"[147]":cc=0:d=6:gosub1045:rem ** sort hand of cards **
  65. 610 forl=1to6
  66. 620 r$=r$(l):s$=s$(l):r=rh(l)
  67. 630 c$="":ifr$="10"thenc$="[157]"
  68. 640 gosub1215:rem ** build graphics zone **
  69. 650 onrgosub1300,1350,1400,1450,1500,1550,1600,1650,1700,1750,1800,1850,1900
  70. 654 rem ** print card **
  71. 660 print"";:ifl<4thentb=cc*8+4:printtab(tb);l
  72. 661 ifs$="[211]"ors$="[218]"thenprint"";:goto663
  73. 662 print"[144]";
  74. 663 ifl<4then666
  75. 664 ifl=4thencc=0:print""
  76. 665 tb=cc*8+10
  77. 666 poke54276,129:forj=1to11:printtab(tb);a$(j):nextj:print"";:poke54276,128
  78. 667 ifl>3thenprinttab(tb);l
  79. 668 cc=cc+1:print"[145][145][145][145][145][145][145][145][145][145][145][145][145]":nextl:print""tab(30)"hand"w"[157][157][157]#[146]"
  80. 670 print"";
  81. 671 printtab(11)"select 2 cards for"
  82. 672 printtab(11)"crib."
  83. 673 printtab(11)"game points:[151]";gt
  84. 674 printtab(18)"[145][145][145]1st: [164]         [157][157][157][157][157][157][157][157][157][157]";
  85. 675 poke198,0:wait198,1:getc1$:ifc1$="0"then63000
  86. 676 ifval(c1$)<1orval(c1$)>6then675
  87. 677 :
  88. 678 printc1$"  2nd: [164][157]";:c1=val(c1$)
  89. 679 getc2$:ifval(c2$)<1orval(c2$)>6orc2$=c1$then679
  90. 680 printc2$:c2=val(c2$)
  91. 683 print"     [218] hit <return>[146] to score hand [218]";
  92. 685 geta$:ifa$=""then685
  93. 686 ifa$=chr$(20)ora$=chr$(157)then670
  94. 687 ifa$<>chr$(13)then685
  95. 690 cd=3:k=1:forj=1to6
  96. 695 ifj=c1orj=c2thenrc$(cd)=r$(j):sc$(cd)=s$(j):rc(cd)=rh(j):goto700
  97. 698 goto705
  98. 700 vc(cd)=vh(j):cd=cd+1:goto708
  99. 705 rs$(k)=r$(j):ss$(k)=s$(j):rs(k)=rh(j):vs(k)=vh(j):k=k+1
  100. 708 nextj
  101. 710 fork=1to4:r$(k)=rs$(k):s$(k)=ss$(k):rh(k)=rs(k):vh(k)=vs(k):nextk
  102. 720 ifw=6thentr$=tr$(2):ts$=ts$(2):tr=tr(2):tv=tv(2):goto760
  103. 722 gosub1005:rem ** deal turn-up **
  104. 725 ifde(i)>39then745
  105. 730 ifde(i)>26then750
  106. 735 ifde(i)>13then755
  107. 740 r=de(i):ts$="[211]":goto757
  108. 745 r=de(i)-39:ts$="[193]":goto757
  109. 750 r=de(i)-26:ts$="[216]":goto757
  110. 755 r=de(i)-13:ts$="[218]"
  111. 757 tr$=rr$(r):tr=r(r):tv=v(r)
  112. 760 i=i+1:r$(5)=tr$:s$(5)=ts$:rh(5)=tr:vh(5)=tv
  113. 770 d=5:gosub1045:rem ** sort hand of 5 **
  114. 775 sw=0:gosub2000:rem ** score hand **
  115. 780 gosub2310:rem ** score flush in hand **
  116. 782 c$="[157]":print"[147]"tab(15)" hand #";w;c$;" [146]"
  117. 785 cc=0:forl=1to5:r$=r$(l):s$=s$(l):r=rh(l)
  118. 788 c$="":ifr$="10"thenc$="[157]"
  119. 790 gosub1215:rem ** graphics **
  120. 795 onrgosub1300,1350,1400,1450,1500,1550,1600,1650,1700,1750,1800,1850,1900
  121. 796 ifs$="[211]"ors$="[218]"thenprint"";:goto798
  122. 797 print"[144]";
  123. 798 tb=cc*6+3:poke54276,129:forj=1to11:printtab(tb);a$(j):nextj:poke54276,128
  124. 800 cc=cc+1:print"[145][145][145][145][145][145][145][145][145][145][145][145]":nextl:print"";
  125. 802 print""
  126. 804 printtab(10)"turn-up is:      ";:tc$="[144]":ifts$="[218]"orts$="[211]"thentc$=""
  127. 805 printtc$+tr$+ts$+""
  128. 806 printtab(10)"points in hand: ";tp
  129. 808 printtab(10)"game points:    [151]";gt
  130. 815 printtab(4)"[218] hit <return>[146] to score crib [218]";
  131. 817 geta$:ifa$=""then817
  132. 820 ifa$<>chr$(13)then817
  133. 825 rem ** move crib var.to hand **
  134. 830 forx=1to4:r$(x)=rc$(x):s$(x)=sc$(x):rh(x)=rc(x):vh(x)=vc(x):nextx
  135. 832 r$(5)=tr$:s$(5)=ts$:rh(5)=tr:vh(5)=tv
  136. 835 d=5:gosub1045:rem ** sort crib of 5 **
  137. 836 sw=1:gosub2000:rem ** score crib **
  138. 837 gosub2400:rem ** score flush **
  139. 838 c$="[157]":print"[147]"tab(15)" crib #";w;c$;" [146]"
  140. 840 cc=0:tb=0:forl=1to5
  141. 845 r$=r$(l):s$=s$(l):r=rh(l):c$="":ifr$="10"thenc$="[157]"
  142. 850 gosub1215:rem ** graphics **
  143. 852 onrgosub1300,1350,1400,1450,1500,1550,1600,1650,1700,1750,1800,1850,1900
  144. 853 ifs$="[211]"ors$="[218]"thenprint"";:goto856
  145. 854 print"[144]";
  146. 856 tb=cc*6+3:poke54276,129:forj=1to11:printtab(tb);a$(j):nextj:poke54276,128
  147. 858 cc=cc+1:print"[145][145][145][145][145][145][145][145][145][145][145][145]":nextl:print"";
  148. 861 printtab(10)"turn-up is:      ";tc$+tr$+ts$+""
  149. 862 printtab(10)"points in crib: ";tp
  150. 863 printtab(10)"game points:    [151]";gt
  151. 864 print" [218] hit <return>[146] to deal another hand [218]";
  152. 865 geta$:ifa$=""then865
  153. 867 ifa$<>chr$(13)then865
  154. 870 rem ** store turn-up in hold **
  155. 880 tr$(s)=tr$:ts$(s)=ts$:tr(s)=tr:tv(s)=tv:s=s+1
  156. 890 nextw
  157. 900 rem *** last hand ***
  158. 905 forx=2to5:r$(x-1)=tr$(x):s$(x-1)=ts$(x):rh(x-1)=tr(x):vh(x-1)=tv(x):nextx
  159. 910 r$(5)="":s$(5)="":rh(5)=15:vh(5)=15
  160. 920 d=4:gosub1045:rem ** sort last hand **
  161. 930 print"[147]"
  162. 935 gosub2000:rem ** score hand of 4 **
  163. 937 gosub2310:rem ** score flush **
  164. 939 print"[147]"tab(14)" last hand [146]"
  165. 940 cc=0:forl=1to4
  166. 945 r$=r$(l):s$=s$(l):r=rh(l):c$="":ifr$="10"thenc$="[157]"
  167. 950 gosub1215:rem ** graphics **
  168. 955 onrgosub1300,1350,1400,1450,1500,1550,1600,1650,1700,1750,1800,1850,1900
  169. 957 ifs$="[211]"ors$="[218]"thenprint"";:goto960
  170. 958 print"[144]";
  171. 960 tb=cc*6+6:poke54276,129:forj=1to11:printtab(tb);a$(j):nextj:poke54276,128
  172. 962 cc=cc+1:print"[145][145][145][145][145][145][145][145][145][145][145][145]":nextl
  173. 965 printtab(13)"last hand:";tp
  174. 966 printtab(11)"game points:[151]";gt
  175. 968 print"  [218] hit <return>[146] to view game totals [218]";
  176. 970 geta$:ifa$=""then970
  177. 971 ifa$<>chr$(13)then970
  178. 972 ifgt>ghthengh=gt
  179. 973 gc=gc+1:ga=ga+gt
  180. 980 print"[147][154]"tab(7)"[213][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][201]"
  181. 981 printtab(7)"[194]   cribbage solitaire[154]   [221]"
  182. 982 printtab(7)"[194]  statistical averages[154]  [221]"
  183. 984 printtab(7)"[202][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][203] "
  184. 985 printtab(9)"game points  :    ";gt
  185. 986 printtab(9)"last avg/hand:    ";fnb(hl/6):iffnb(hl/6)>hhthenhh=fnb(hl/6)
  186. 987 printtab(9)"last avg/crib:    ";fnb(cl/6):iffnb(cl/6)>hcthenhc=fnb(cl/